#!/usr/bin/perl

package CSS::Preprocessor::Tokenizer;

use strict;
use warnings;
use utf8;
use fields qw(
    source
    source_length
    line
    column
    peeked_token
    buffer_name
);

use CSS::Preprocessor::BufferPos;
use CSS::Preprocessor::ParseError;

use CSS::Preprocessor::Token;
use CSS::Preprocessor::Token::Ident;
use CSS::Preprocessor::Token::AtKeyword;
use CSS::Preprocessor::Token::Function;
use CSS::Preprocessor::Token::String;
use CSS::Preprocessor::Token::Number;
use CSS::Preprocessor::Token::Punctuation;
use CSS::Preprocessor::Token::VariableReference;

# NOTE: This implementation is currently very basic and assumes
# an infinite amount of lookahead because it just loads the entire
# source file into memory.
# It might be nice to rework this at some point so that it can
# work from a stream.
# (Don't depend on the internals of this class!)

my $RE_WHITESPACE_CHAR = qr([ \t\r\n\f]);
my $RE_NONASCII = qr([^\0-\177]);
my $RE_UNICODE = qr(\\[0-9a-f]{1,6}$RE_WHITESPACE_CHAR?);
my $RE_ESCAPE = qr($RE_UNICODE|\\[ -~\xC8-\xFF]); # FIXME: This is not the full unicode range
my $RE_NMSTART = qr([a-zA-Z]|$RE_NONASCII|$RE_ESCAPE);
my $RE_NMCHAR = qr([a-z0-9-]|$RE_NONASCII|$RE_ESCAPE);
my $RE_NAME = qr($RE_NMCHAR+);
my $RE_IDENT = qr($RE_NMSTART$RE_NMCHAR*);
my $RE_NUM = qr([0-9]+|[0-9]*\.[0-9]+);
my $RE_NL = qr(\n|\r\n|\r|\f);
my $RE_STRING1 = qr(\"([\t !#\$%&\(-~]|\\$RE_NL|\'|$RE_NONASCII|$RE_ESCAPE)*\");
my $RE_STRING2 = qr(\'([\t !#\$%&\(-~]|\\$RE_NL|\"|$RE_NONASCII|$RE_ESCAPE)*\');
my $RE_STRING = qr($RE_STRING1|$RE_STRING2);
my $RE_W = qr($RE_WHITESPACE_CHAR*);
my $RE_COMMENT = qr(\/\*[^*]*\*+([^/][^*]*\*+)*\/);

sub new_for_stringref {
    my ($class, $ref, $buffer_name) = @_;

    my $self = fields::new($class);
    $self->{source} = $ref;
    $self->{source_length} = length($$ref);
    $self->{line} = 1;
    $self->{column} = 1;
    $self->{peeked_token} = undef;
    $self->{buffer_name} = $buffer_name || "(unknown)";
    pos($$ref) = 0;

    return $self;
}

sub new_for_fh {
    my ($class, $fh, $buffer_name) = @_;

    die "Loading from filehandle is not yet supported";
}

sub get_token {
    my CSS::Preprocessor::Tokenizer $self = shift;

    my $ret = $self->peek_token();
    $self->{peeked_token} = undef;
    return $ret;
}

sub peek_token {
    my CSS::Preprocessor::Tokenizer $self = shift;

    if ($self->{peeked_token}) {
        return $self->{peeked_token};
    }
    else {
        my $ret = $self->_make_token();
        return $self->{peeked_token} = $ret;
    }
}

sub _make_token {
    my CSS::Preprocessor::Tokenizer $self = shift;

    my $s = $self->{source};

    # Skip any whitespace and comments
    while ($$s =~ m!\G($RE_WHITESPACE_CHAR+|$RE_COMMENT)!sgc) {
        my $space = $&;
        $self->_adjust_position($&);
    }

    return undef if (pos($$s) == length($$s));

    my $ret = undef;

    my $start_pos = pos($$s);

    if ($$s =~ /\G$RE_IDENT/sgc) {
        my $ident_raw = $&;
        my $ident = $self->_expand_ident_escapes($ident_raw);
        if ($$s =~ /\G\(/sgc) {
            $ret = CSS::Preprocessor::Token::Function->new($ident);
        }
        else {
            $ret = CSS::Preprocessor::Token::Ident->new($ident);
        }
    }
    elsif ($$s =~ /\G\@(-?$RE_IDENT)/sgc) {
        my $ident_raw = $1;
        my $ident = $self->_expand_ident_escapes($ident_raw);
        $ret = CSS::Preprocessor::Token::AtKeyword->new($ident);
    }
    elsif ($$s =~ /\G$RE_STRING/sgc) {
        my $string_raw = $&;
        my $string = $self->_expand_string($string_raw);
        $ret = CSS::Preprocessor::Token::String->new($string);
    }
    elsif ($$s =~ /\G$RE_NUM/sgc) {
        my $raw_num = $&;
        if ($$s =~ /\G\%/sgc) {
            $ret = CSS::Preprocessor::Token::Number->new($raw_num, '%');
        }
        elsif ($$s =~ /\G$RE_IDENT/sgc) {
            my $ident = $self->_expand_ident_escapes($&);
            $ret = CSS::Preprocessor::Token::Number->new($raw_num, $ident);
        }
        else {
            $ret = CSS::Preprocessor::Token::Number->new($raw_num);
        }
    }
    elsif ($$s =~ /\G(?:~=|\|=|\.\.|\|\||&&|==)/sgc) {
        # Multi-character punctuation symbols need to be handled first
        # to avoid them getting split apart.
        my $punct = $&;
        $ret = CSS::Preprocessor::Token::Punctuation->new($punct);
    }
    elsif ($$s =~ /\G\$($RE_IDENT)/sgc) {
        my $var_name = $1;
        $ret = CSS::Preprocessor::Token::VariableReference->new($var_name);
    }
    elsif ($$s =~ /\G./sgc) {
        # CSS2 spec says that all unrecognised characters become "delim" tokens.
        # By this point everything else is punctuation, because we've already
        # excluded all of the non-ASCII unicode characters as well as digits and
        # latin letters. Therefore we're just lumping them in with all of the
        # other punctuation.
        my $punct = $&;
        $ret = CSS::Preprocessor::Token::Punctuation->new($punct);
    }

    if (! $ret) {
        $$s =~ /\G\S+/sgc;
        die "Something has gone horribly wrong" unless $&;
        die "I don't know what to make of '".$&."'";
    }

    my $end_pos = pos($$s);

    # If we've managed to consume nothing, then we must be at the end
    return undef if $start_pos == $end_pos;

    # Figure out what string we've actually consumed so that we
    # can calculate the new current line and column.
    my $raw_chars = substr($$s, $start_pos, $end_pos - $start_pos);

    $ret->set_position($self->current_position());
    $self->_adjust_position($raw_chars);

    return $ret;

}

sub current_position {
    my CSS::Preprocessor::Tokenizer $self = shift;
    return CSS::Preprocessor::BufferPos->new(
        char => pos(${$self->{source}}),
        line => $self->{line},
        column => $self->{column},
        buffer_name => $self->{buffer_name},
    );
}

sub next_is_bare_number {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $peek = $self->peek_token();
    return $peek->isa('CSS::Preprocessor::Token::Number') && $peek->is_bare_number;
}

sub next_is_percentage {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $peek = $self->peek_token();
    return $peek->isa('CSS::Preprocessor::Token::Number') && $peek->is_percentage;
}

sub next_is_dimension {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $unit = shift;
    my $peek = $self->peek_token();
    if ($peek->isa('CSS::Preprocessor::Token::Number') && $peek->is_dimension) {
        return defined($unit) ? $unit eq $peek->unit : 1;
    }
}

sub next_is_string {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $peek = $self->peek_token();
    return $peek->isa('CSS::Preprocessor::Token::String');
}

sub next_is_class {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $class = shift;
    my $peek = $self->peek_token();
    return $peek->isa('CSS::Preprocessor::Token::'.$class);
}

sub next_is_identifier {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $name = shift;
    my $peek = $self->peek_token();
    if (UNIVERSAL::isa($peek, 'CSS::Preprocessor::Token::Ident')) {
        return defined($name) ? $name eq $peek->name : 1;
    }
}

sub next_is_function {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $name = shift;
    my $peek = $self->peek_token();
    if (UNIVERSAL::isa($peek, 'CSS::Preprocessor::Token::Function')) {
        return defined($name) ? $name eq $peek->name : 1;
    }
}

sub next_is_at_keyword {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $name = shift;
    my $peek = $self->peek_token();
    if (UNIVERSAL::isa($peek, 'CSS::Preprocessor::Token::AtKeyword')) {
        return defined($name) ? $name eq $peek->name : 1;
    }
}

sub next_is_punctuation {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $chars = shift;
    my $peek = $self->peek_token();
    if ($peek->isa('CSS::Preprocessor::Token::Punctuation')) {
        return defined($chars) ? $chars eq $peek->chars : 1;
    }
}

sub require_token {
    my CSS::Preprocessor::Tokenizer $self = shift;

    my $ret = $self->get_token();

    if ($ret) {
        return $ret;
    }
    else {
        die CSS::Preprocessor::ParseError->new_expecting_but_got(
            "a token",
            $ret,
        );
    }
}

sub require_punctuation {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $chars = shift;

    return $self->get_token if $self->next_is_punctuation($chars);

    die CSS::Preprocessor::ParseError->new_expecting_but_got(
        $chars || "punctuation",
        $self->peek_token,
    );
}

sub require_identifier {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $name = shift;

    return $self->get_token if $self->next_is_identifier($name);

    die CSS::Preprocessor::ParseError->new_expecting_but_got(
        $name || "identifier",
        $self->peek_token,
    );
}

sub require_at_keyword {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $name = shift;

    return $self->get_token if $self->next_is_at_keyword($name);

    die CSS::Preprocessor::ParseError->new_expecting_but_got(
        $name ? '@'.$name : "at-keyword",
        $self->peek_token,
    );
}

sub _adjust_position {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $source_text = shift;

    return unless defined $source_text;

    if (my $newlines = ($source_text =~ tr/\n/\n/)) {
        $self->{line} += $newlines;
        if ($source_text =~ /\n(.*)$/m) {
            $self->{column} = 1 + length $1;
        }
    } else {
        $self->{column} += length $source_text;
    }
}

sub _expand_ident_escapes {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $raw_ident = shift;

    # A backslash followed by 1 to 6 hex digits is a character reference
    $raw_ident =~ s/\\([0-9a-f]{1,6})$RE_WHITESPACE_CHAR?/ chr(hex($1)) /e;

    # All other backslashes just exist to escape the special meaning of something,
    # so we can remove them now.
    $raw_ident =~ s/([^\\])\\]/$1/g;
    $raw_ident =~ s/\\\\/\\/g;

    return $raw_ident;
}

sub _expand_string {
    my CSS::Preprocessor::Tokenizer $self = shift;
    my $raw_string = shift;

    # We don't want the quote marks on either end
    $raw_string = substr($raw_string, 1, -1);

    # Remove escaped newlines
    $raw_string =~ s/\\(\n|\r\n|\r)//;

    # Do normal character reference escapes
    return $self->_expand_ident_escapes($raw_string);
}

=head1 NAME

CSS::Preprocessor::Tokenizer - Tokenizer class for CSS Preprocessor

=head1 DESCRIPTION

This class provides a tokenizer for the CSS::Preprocessor language.
This language is roughly a superset of CSS2, though some liberties
are taken.

=head1 COPYRIGHT

Copyright 2008 Martin Atkins <mart@degeneration.co.uk>

Based in part on S2::Tokenizer, which is Copyright 2002 Six Apart, Ltd.
S2::Tokenizer is part of the S2 template system, and was written by
Brad Fitzpatrick <brad@danga.com>.

=head1 LICENCE

This module may be distributed under the terms of the GNU General Public Licence
version 2.

=cut

1;
